open Types
open Utils
open Cfg

(** {2 Fonctions concernant l'analyse des expressions disponibles} *)

(** {3 Fonctions utiles et d'affichage} *)

(** [get lst ind] permet de récupérer la liste des variables actives IN/OUT pour un label 
    @param lst la liste de tous les labes
    @param ind le label concerné
*)
let rec ae_get lst ind = match lst with
  | [] -> {lbl= ind ; _in=[] ; out=[]}
  | AvailExpr(a)::l -> if a.lbl == ind then a else ae_get l ind

(** [ae_set lst pelt] permet de modifier la liste des variables actives IN/OUT pour un label 
    @param lst la liste de tous les labes
    @param pelt la nouvelle liste de variables actives IN/OUT
*)
let rec ae_set lst (AvailExpr(elt')) = 
  let elt = AvailExpr({elt' with 
      _in=uniq elt'._in ;
      out=uniq elt'.out
    })  in 
          ae_set_aux lst elt elt'.lbl
and ae_set_aux lst elt lbl = 
  match lst with
  | [] -> elt::[]
  | AvailExpr(a) as a'::l -> if a.lbl == lbl then 
      elt::l
    else
      a'::(ae_set_aux l elt lbl)

let rec string_of_ae_elt_part lae = 
  match lae with
    | [] -> ""
    | (Var v, e)::lae -> "("^v^","^(string_of_expr e)^") "^(string_of_ae_elt_part lae)

let print_avail_expr lae cur prefix  = 
    print_string ((string_of_int cur)^": ");
    print_string prefix ;
    let space = get_space 50 (String.length prefix) in 
      print_string (String.make space ' ') ;
      let elt = ae_get lae cur in
        let s_in = string_of_ae_elt_part elt._in in 
          let space2 = get_space 20 (String.length s_in) in 
            print_string ("in: " ^s_in);
            print_string (String.make space2 ' ');
            print_endline ("out: "^(string_of_ae_elt_part elt.out))

let rec ae_intersect l = 
  match l with
  | [] -> []
  | l1::[] -> l1
  | l1::l2::l' -> ae_intersect ((ae_intersect_aux l1 l2)::l')

and ae_intersect_aux l1 l2 =
	List.filter (
      fun (Var v1, e1) -> (List.exists (
  		fun (Var v2, e2) -> 
  			v1 = v2 && equal_expr e1 e2
  		) l2)
    ) l1

let rec ae_equal lae1 lae2 = 
  if List.length lae1 != List.length lae2 then
    false
  else
    match lae1 with
    | [] -> true
    | a::lae1 -> ae_equal_aux2 a lae2
and ae_equal_aux2 a lae2 = 
  match lae2, a with
    | [],_ -> false
    | AvailExpr({lbl=i ; _in=vli1 ; out= vlo1})::lae2, 
      AvailExpr({lbl=j ; _in=vli2 ; out= vlo2}) -> if i == j then
        ae_equal_aux vli1 vli2 && ae_equal_aux vlo1 vlo2
      else 
        ae_equal_aux2 a lae2 

and ae_equal_aux vl1 vl2 = match vl1, vl2 with
  | [], [] -> true
  | [], _ | _, [] -> false
  | (Var(v1),e1)::vl1, (Var(v2),e2)::vl2 -> v1 = v2 && equal_expr e1 e2 && ae_equal_aux vl1 vl2

(** {3 Fonctions relatives à l'analyse} *)

(** [ae_gen lst ta] réalise la fonction "gen",
	renvoie la liste des résultats, si l'instruction courante est une assignation, 
	et si la variable assignée n'est pas présente dans l'expression RHS
 *)
let rec ae_gen lst instr = match instr with
  | Assign(Var(v), e, _) -> if List.exists (fun (Var v') -> v' = v) (get_vars e) then
  					  lst
  					else
  					  (Var(v),e)::lst
  | _ -> lst

(** [ae_kill lst ta] réalise la fonction "kill", 
	renvoie la liste des résultats, si l'instruction courante est une assignation,
	et enlève tout élément contenant la variable assignée en RHS ou LHS
.*)
let rec ae_kill lst instr = match instr with
  | Assign(v, e, _) -> ae_kill_aux lst v
  | _ -> lst
and ae_kill_aux lst (Var v) = match lst with
  | [] -> []
  | (Var(v'),e)::l -> let nl = ae_kill_aux l (Var v) in
  				if v' = v || List.exists (fun (Var v'') -> v'' = v) (get_vars e) then
  				  nl
  				else
  				  (Var(v'),e)::nl

(** Contient le résultat de l'analyse *)
let ae_ana = ref []

(** [ae p flw cur] propage les expressions actives dans l'instruction "cur" du programme "p" dont le flow est "flw"*)
let ae p flw cur = let instr = get_instr p cur in 
  if cur == (init p) then
    ae_ana := ae_set !ae_ana (AvailExpr({
      lbl= cur ;
      _in= [];
      out= ae_gen [] instr
    }))
  else
    let prds = preds flw cur in 
      let plae = List.map (fun (AvailExpr c) -> c.out) (
			        List.filter (
			          fun (AvailExpr a) -> (List.exists (fun b -> a.lbl == b ) prds)
			        ) 
			    !ae_ana) 
  	  in
	 	let _in = ae_intersect plae in
	  	  ae_ana := ae_set !ae_ana (AvailExpr({
	        lbl= cur ;
	        _in= _in;
	        out= ae_gen (ae_kill _in instr) instr
	    }))
